home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 2 / Mac Magazin and MacEasy Magazine CD - Issue 02.iso / Themen Mac Magazin / Multimedia / Grafik-&QT Tools / NIH Image 1.53 (non-fpu) / Macros / Editing Macros < prev    next >
Text File  |  1993-12-13  |  4KB  |  184 lines
  1. var {Global variable, initially zero}
  2.   RoiLeft,RoiTop,RoiRight,RoiBottom:integer;
  3.  
  4. macro 'Show Tools [T]';
  5. begin
  6.   SelectWindow('Tools');
  7. end;
  8.  
  9. Macro 'Draw Arrow [A]'
  10. {Draws an arrow based on the current straight line selection.}
  11. var
  12.   size,angle,dx,dy,pi,theta:real;
  13.   x1,y1,x2,y2,LineWidth,width,height:integer;
  14. begin
  15.   size:=12;  {pixels}
  16.   angle:=20; {degrees}
  17.   pi:=3.14159;
  18.   GetLine(x1,y1,x2,y2,LineWidth);
  19.   if x1<0 then begin
  20.     PutMessage('Use the line tool(straight) to select a line first.');
  21.     exit;
  22.   end;
  23.   MoveTo(x1,y1);
  24.   LineTo(x2,y2);
  25.   KillRoi;
  26.   GetPicSize(width,height);
  27.   y1:=height-y1;
  28.   y2:=height-y2;
  29.   if LineWidth>1 then size:=size*LineWidth*0.5;
  30.   angle:=(angle/180)*pi;
  31.   dx:=x1-x2;
  32.   dy:=y1-y2;
  33.   if dx=0 then begin
  34.     if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  35.   end else begin
  36.     theta:=arctan(dy/dx);
  37.     if dx<0 then theta:=theta+pi;
  38.   end;
  39.   moveto(x2,height-y2);
  40.   lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
  41.   moveto(x2,height-y2);
  42.   lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
  43. end;
  44.  
  45. macro 'Clear Outside [C]'
  46.  {Erase region outside current selection to background color.}
  47. begin
  48.   Copy;
  49.   SelectAll;
  50.   Clear;
  51.   RestoreRoi;
  52.   Paste;
  53.   KillRoi;
  54. end;
  55.  
  56. macro 'Change Colors';
  57. {
  58. Changes the value of pixels in the image that are in
  59. the current foreground color to the current background
  60. color. Use Undo if you don't like the result.
  61. }
  62. var
  63.   SavePixel,foreground,background:integer;
  64.  begin
  65.   SavePixel:=GetPixel(0,0);
  66.   MakeRoi(0,0,1,1);
  67.   Fill;
  68.   foreground:=GetPixel(0,0);
  69.   Clear;
  70.   background:=GetPixel(0,0);
  71.   PutPixel(0,0,SavePixel);
  72.   PutMessage('Pixels in the foreground color (',foreground:1,') will be changed to the background color (',background:1,').');
  73.   ChangeValues(foreground,foreground,background);
  74. end;
  75.  
  76. macro 'Change Values…';
  77. var
  78.   v1,v2:integer;
  79. begin
  80.   v1:=GetNumber('Change pixels with this value:',255);
  81.   v2:=GetNumber('to this value:',254);
  82.   ChangeValues(v1,v1,v2);
  83. end;
  84.  
  85. macro 'Fix Pseudocolors';
  86. begin
  87.   ChangeValues(0,0,1);
  88.   ChangeValues(255,255,254);
  89. end;
  90.  
  91. macro 'Remove Isolated Black Lines';
  92. var
  93.   width,height,value,x,y,xstart,ystart:integer;
  94. begin
  95.   GetRoi(xstart,ystart,width,height);
  96.   if width=0 then begin
  97.     PutMessage('This macro requires a retangular selection');
  98.     exit;
  99.   end;
  100.   for y:=ystart to ystart+height-1 do begin
  101.     if GetPixel(width div 2,y)=255 then
  102.       for x:=xstart to xstart+width-1 do
  103.         PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  104.   end;
  105.   KillRoi;
  106. end;
  107.  
  108. macro 'Make Mosaic';
  109. var
  110.   n:integer;
  111. begin
  112.   SaveState;
  113.   n:=GetNumber('Cell Size(pixels square):',8);
  114.   Duplicate('Mosaic');
  115.   SetScaling('Nearest; Same Window');
  116.   ScaleSelection(1/n,1/n);
  117.   RestoreRoi;
  118.   ScaleSelection(n,n);
  119.   RestoreState;
  120. end;
  121.  
  122. macro 'Draw Grid…';
  123. var
  124.   x,y,xinc,yinc,width,height:integer;
  125. begin
  126.   GetPicSize(width,height);
  127.   xinc:=GetNumber('Horizontal Spacing:',16);
  128.   yinc:=GetNumber('Vertical Spacing:',xinc);
  129.   x:=0;
  130.   y:=0;
  131.   repeat
  132.     x:=x+xinc;
  133.     y:=y+yinc;
  134.     moveto(0,y);
  135.     lineto(width,y);
  136.     moveto(x,0);
  137.     lineto(x,height);
  138.   until (x>width) and (y>height);
  139. end;
  140.  
  141. macro 'Make 256x256 Selection [S]';
  142. {Creates a 256x256 selection centered on the image.}
  143. var
  144.   w,h:integer;
  145. begin
  146.   GetPicSize(w,h);
  147.   MakeRoi((w-246)/2,(h-256)/2, 256, 256);
  148. end;
  149.  
  150. macro '(-' begin end;
  151.  
  152. macro 'Define Upper Left [1]';
  153. var
  154.   x1,y1,x2,y2,LineWidth:integer;
  155. begin
  156.   GetLine(x1,y1,x2,y2,LineWidth);
  157.   if x1<0 then begin
  158.      PutMessage('Click with line selection tool to define upper left corner of ROI.');
  159.      exit;
  160.   end;
  161.   RoiLeft:=x1+(x2-x1)/2;
  162.   RoiTop:=y1+(y2-y1)/2;
  163. end;
  164.  
  165. macro 'Define Lower Right and Create ROI [2]';
  166. var
  167.   x1,y1,x2,y2,LineWidth:integer;
  168. begin
  169.   GetLine(x1,y1,x2,y2,LineWidth);
  170.   if x1<0 then begin
  171.      PutMessage('Click with line selection tool to define lower right corner of ROI.');
  172.      exit;
  173.   end;
  174.   RoiRight:=x1+(x2-x1)/2;
  175.   RoiBottom:=y1+(y2-y1)/2;
  176.   if (RoiLeft=RoiRight) and (RoiTop=RoiBottom) then begin
  177.     PutMessage('Upper left and bottom right are the same.');
  178.     exit;
  179.   end;
  180.   MakeRoi(RoiLeft,RoiTop,RoiRight-RoiLeft,RoiBottom-RoiTop)
  181. end;
  182.  
  183.  
  184.